home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / multi-4a / server_c.bas < prev    next >
BASIC Source File  |  1999-08-31  |  4KB  |  177 lines
  1. Attribute VB_Name = "login_logout"
  2. 'this bas file contains the connection information which
  3. 'allows more than 1 user to join, and leave. also handles
  4. 'their accounts.
  5.  
  6. Sub new_connection(requestid As Long)
  7. 'new connection, so give them a socket
  8.  
  9. 'socket for new user to have
  10. Dim use_socket As Integer
  11.  
  12. 'check if the server is full (with clients) or not
  13. If live_connections >= max_clients Then disallow_connection requestid, message_1: Exit Sub
  14.  
  15. 'search the loaded sockets to see if any are long
  16. For i = 1 To (main.sock.Count - 1)
  17. If main.sock(i).Tag = "0" Then
  18. use_socket = i
  19. GoTo found_sock
  20. End If
  21. Next i
  22.  
  23. 'no sockets free so create a new socket
  24. Dim socket_to_create As Integer
  25. socket_to_create = main.sock.Count
  26. Load main.sock(socket_to_create)
  27. use_socket = socket_to_create
  28.  
  29.  
  30. found_sock:
  31.  
  32. 'log them in (if no socket found then act as if it were full)
  33. If login_client(use_socket, requestid) = False Then disallow_connection requestid, message_1: Exit Sub
  34. 'update info
  35. update_info
  36.  
  37. End Sub
  38.  
  39. Function login_client(socket As Integer, requestid As Long) As Boolean
  40. 'client connected, so now find him a clientid and setup
  41. 'his own account, returns if he managed to log in or not
  42.  
  43. For i = 1 To max_clients
  44. If client(i).socket = "0" Then
  45. 'found an empty client
  46.  
  47.  
  48.  
  49.  
  50.  
  51. 'set client settings
  52. client(i).connected_at = f_time
  53. client(i).idle_since = f_time
  54. client(i).socket = socket
  55.  
  56. 'tag the socket to remember the clientID
  57. main.sock(socket).Tag = i
  58.  
  59. 'connect them on the chosen socket
  60. main.sock(socket).Close
  61. main.sock(socket).Accept requestid
  62.  
  63. 'User logged in ok (show in status)
  64. update_status "Client " & i & " Logged In (" & main.sock(user_socket).RemoteHostIP & ")"
  65.  
  66. 'recount live-connections
  67. live_connections = live_connections + 1
  68.  
  69. 'send welcome message
  70. send_data socket, message_2
  71.  
  72.  
  73.  
  74.  
  75.  
  76. login_client = True
  77. Exit Function
  78. End If
  79. Next i
  80. 'All sockets are in use, so return as false
  81.  
  82. End Function
  83.  
  84. Sub kickout_client(socket As Integer, notice As String)
  85. 'if you log them out and what them to know the reason.
  86.  
  87. send_data socket, notice
  88. logout_client socket, notice
  89.  
  90.  
  91. End Sub
  92.  
  93.  
  94. Sub logout_client(socket As Integer, reason As String)
  95. 'client has disconnected, so close
  96. 'his socket, and blank out his clientid
  97. 'so sombody else can use it.
  98. 'the reason is simply their for status purposes.
  99.  
  100. 'disconnect him
  101. main.sock(socket).Close
  102.  
  103. 'clear his account (remember its the SOCKET, not clientID)
  104. client(main.sock(socket).Tag).connected_at = "N/A"
  105. client(main.sock(socket).Tag).idle_since = "N/A"
  106. client(main.sock(socket).Tag).socket = "0"
  107.  
  108.  
  109. 'User logged out (show in status)
  110. update_status "Client " & main.sock(socket).Tag & " Logged Out (" & reason & ")"
  111.  
  112. 'Unasign his socket
  113. main.sock(socket).Tag = "0"
  114.  
  115.  
  116.  
  117.  
  118. 'recount live-connections
  119. live_connections = live_connections - 1
  120.  
  121. 'update info
  122. update_info
  123.  
  124. End Sub
  125.  
  126. Sub disallow_connection(requestid As Long, reason As String)
  127. 'if you dont want sombody to be allowed to connect,
  128. 'instead of just not envoking the new_connection command
  129. 'envoke this as it lets them connect to a special socket,
  130. 'which'll then tell them the reason they cannot connect
  131. 'and then disconnect them from intself.
  132. 'ideal for 'server full' style messages
  133.  
  134. 'User logged in ok (show in status)
  135. update_status "Client Rejected (" & reason & ")"
  136.  
  137. 'if no reason given, dont try to tell him it
  138. If reason = "" Then Exit Sub
  139.  
  140.  
  141. main.disallow.Close
  142. main.disallow.Accept requestid
  143. DoEvents
  144.  
  145. main.disallow.SendData reason
  146. DoEvents
  147.  
  148. main.disallow.Close
  149.  
  150. End Sub
  151.  
  152.  
  153. Function count_sockets() As Integer
  154. 'show the number of sockets loaded
  155.  
  156. count_sockets = main.sock.Count
  157.  
  158. End Function
  159.  
  160.  
  161. Sub count_live_connections()
  162. 'recount the connections (not used anymore)
  163.  
  164.  
  165. 'count how many are connected
  166. Dim temp As Integer
  167.  
  168. For i = 1 To (main.sock.Count - 1)
  169. If main.sock(i).State <> scklong Then temp = temp + 1
  170. Next i
  171.  
  172. 'set it
  173. live_connections = temp
  174.  
  175. End Sub
  176.  
  177.